home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / prg_basi / gridcode.zip / GRIDCODE.BAS < prev   
BASIC Source File  |  1996-09-28  |  9KB  |  256 lines
  1. Option Explicit     ' ⌐ Ian Patton, 1994-96 - ipatton@indigo.ie
  2.  
  3. 'Here is a simple routine I have devised which for me
  4. 'simplifies the printing of the contents of a TruegGrid to the
  5. 'printer. There are also two Grid Copy routines: one for the
  6. 'standard VB Grid control and one for TrueGrid. They are all
  7. 'independent of column or row numbers so should work straight off.
  8.  
  9. 'These routines were dsigned and used in VB 3. They may work in
  10. 'VB 4 but I have'nt tried them yet.
  11.  
  12. 'The copy routines produce Tab Separated text which can then be
  13. 'pasted into any word processor and formatted as required. proper
  14. 'alignment of columns in your word processor may require a change
  15. 'of font or the addition of some Tabs to help balance a column.
  16.  
  17. 'The print routine formats text as it finds it in TrueGrid, ie:
  18. 'Left/Centre/Right aligned as appropriate. I have had to set the
  19. 'print body text to Courier so that Right Alignment would work
  20. 'properly. Proportionally spaced fonts like Arial & Times produce
  21. 'a ragged right margin. If anyone knows how to overcome this, I
  22. 'would welcome your advice.
  23.  
  24. 'You are FREE to use the enclosed as is, or to modify it to suit
  25. 'your needs as required. It is Free. All I would ask is that:
  26.  
  27. '   (a) You do not re-submit the enclosed on any bullitin board,
  28. '       or through any internet service provider as your own work
  29. '       or, if included as part of a larger submission, you leave
  30. '       the copyright/eMail flag at the start of each routine.
  31.  
  32. '   (b) If you use this in your own programs, again leave the
  33. '       copyright/eMail flag at the start of each routine, just
  34. '       to remember me !
  35.  
  36. '   (c) Any chance of giving me feedback, just to say if you
  37. '       found it any use (or not!) and if so, were you able
  38. '       to use any of it
  39.  
  40. 'Any comments, criticisms etc would be welcome. Choose which form
  41. 'of adress best suits you, from below. Good luc :-)
  42.  
  43. 'Compuserve:    100024,1606
  44. 'Internet:      ipatton@indigo.ie
  45.  
  46. 'Usual disclaimer. The enclosed works for me but I can't guarantee
  47. 'that it will work for You. Use at your own risk. By accepting and
  48. 'using the enclosed, you agree that I have no responsibility for
  49. 'any loss, direct or consequential, as a result of your use.
  50.  
  51.  
  52. 'Ian Patton
  53.  
  54. Sub Copy_Grid ()    ' ⌐ Ian Patton, 1994-96 - ipatton@indigo.ie
  55.  
  56.     'Generic sub for clipboard copy from standard GRID.VBX
  57.     
  58.     Dim CopyText As String, NC As String, NR As String
  59.     Dim First_Col As Integer, First_Row As Integer
  60.     
  61.     'GridName = your grid. replace as required
  62.     
  63.     Screen.MousePointer = 11
  64.     Clipboard.Clear                 'not really necessary (but safe)
  65.  
  66.     NC = Chr$(9)                    'Tab Character
  67.     NR = Chr$(13) & Chr$(10)        'Carriage Return & Linefeed
  68.  
  69.     First_Col = GridName.Fixedcols  'Set counter for first column
  70.     First_Row = GridName.FixedRows  'Set counter for first row
  71.     
  72.     For i% = First_Row To GridName.Rows - 1
  73.     GridName.Row = i%
  74.     For j% = 0 + First_Col To GridName.Cols - 1
  75.         GridName.Col = j%
  76.         If j% = First_Col Then
  77.         CopyText = CopyText & GridName.text
  78.         Else
  79.         CopyText = CopyText & NC & GridName.text
  80.         End If
  81.     Next
  82.     CopyText = CopyText & NR
  83.     Next
  84.  
  85.     Clipboard.SetText CopyText
  86.     Screen.MousePointer = 0
  87.  
  88. End Sub
  89.  
  90. Sub Copy_TrueGrid ()    ' ⌐ Ian Patton, 1994-96 - ipatton@indigo.ie
  91.  
  92.     'Generic sub for clipboard copy from TrueGrid
  93.     
  94.     Dim CopyText, TC, CRL As String, r As Integer, c As integr
  95.     Dim First_Col, First_Row As Integer
  96.     
  97.     'MyTrueGrid = your grid. replace as required
  98.     
  99.     Screen.MousePointer = 11    'show Hourglass, copy could take a while
  100.     MyTrueGrid.Active = False   'Stop TrueGrid "flashing"
  101.     Clipboard.Clear             'not really necessary (but safe)
  102.     
  103.     CopyText = ""
  104.     TC = Chr$(9)                'Tab character
  105.     CRL = Chr$(13) & Chr$(10)   'Carriage Return & Linefeed
  106.  
  107.     First_Col = 1               'Set counter for first column
  108.     First_Row = 1               'Set counter for first row
  109.     
  110.     MyTrueGrid.TopRow = 1       'Position to first row
  111.     MyTrueGrid.LeftColumn = 1   'Position to first column
  112.  
  113.     For r = First_Row To RowCount
  114.     MyTrueGrid.RowIndex = r
  115.     For c = First_Col To RateTable.Columns - 1
  116.         MyTrueGrid.ColumnIndex = c
  117.         If MyTrueGrid.ColumnVisible(c) = True Then
  118.         If c = First_Col Then
  119.             CopyText = CopyText & MyTrueGrid.text
  120.         Else
  121.             CopyText = CopyText & TC & MyTrueGrid.text
  122.         End If
  123.         End If
  124.     Next
  125.     CopyText = CopyText & CRL
  126.     Next
  127.  
  128.     Clipboard.SetText CopyText  'Send copied table to clipboard
  129.  
  130.     Screen.MousePointer = 0     'Return cursor to default
  131.     MyTrueGrid.RowIndex = 1     'Re-position to first column
  132.     MyTrueGrid.ColumnIndex = 1  'Re-Position to first column
  133.     MyTrueGrid.Active = True    'Reinstate TrueGrid
  134.  
  135. End Sub
  136.  
  137. Sub Print_MyTrueGrid ()   ' ⌐ Ian Patton, 1994-96 - ipatton@indigo.ie
  138.  
  139.     'Generic print sub for MyTrueGrid tables
  140.     Dim ColStyle, ColWide, TabNow, TabPos, LineCount As Integer
  141.     Dim RptName, RptSub, ColText, PageFoot As String
  142.     Dim r As Integer, n As Integer, c As Integer
  143.  
  144.     'MyTrueGrid = your grid. replace as required
  145.     
  146.     Screen.MousePointer = 11        'show Hourglass, print could take a while
  147.     Printer.ScaleMode = 4           'characters
  148.  
  149.     'Assign text to String Variables
  150.     RptName = "Anything Title you like"     'can be a variable if preferred
  151.     RptSub = "Anything Subtitle you like"   'can be a variable if preferred
  152.     PageFoot = "Page: "
  153.     LineCount = 0
  154.  
  155.     'Set display and position to 1st row / 1st column
  156.     MyTrueGrid.TopRow = 1: MyTrueGrid.RowIndex = 1
  157.     MyTrueGrid.LeftColumn = 1: MyTrueGrid.ColumnIndex = 1
  158.  
  159.     For r = 1 To RowCount
  160.     'Header info ---------------------------------------
  161.     LineCount = LineCount + 1
  162.     If LineCount = 1 Then
  163.         TabPos = 2
  164.         Printer.FontName = "Arial"
  165.         Printer.FontSize = 14: Printer.FontBold = True
  166.         Printer.Print
  167.         Printer.Print Tab(TabPos); RptName
  168.         Printer.Print   'Blank line
  169.         Printer.FontName = "Arial"
  170.         Printer.FontSize = 10: Printer.FontBold = False
  171.         Printer.Print   'Blank line
  172.         Printer.Print Tab(TabPos); RptSub
  173.         Printer.Print   'Blank line
  174.  
  175.         'Table Column names ----------------------------
  176.         Printer.FontName = "Courier New"
  177.         Printer.FontSize = 9: Printer.FontBold = False
  178.         For n = 1 To MyTrueGrid.Columns
  179.         If MyTrueGrid.ColumnVisible(n) = True Then
  180.             'Calculation for Tab() positions
  181.             ColWide = MyTrueGrid.ColumnWidth(n)
  182.             ColText = MyTrueGrid.ColumnName(n)
  183.             ColStyle = MyTrueGrid.ColumnStyle(n)
  184.             'Check your table for col types and change Case as approprate
  185.             Select Case ColStyle
  186.             Case 8192 'Left-align/Read only
  187.                 TabNow = TabPos
  188.             Case 8193 'Centre/Read only
  189.                 TabNow = (TabPos + ColWide \ 2) - (Len(ColText) \ 2)
  190.             Case 8194 'Right-align/Read only
  191.                 TabNow = (TabPos + ColWide) - Len(ColText)
  192.             End Select
  193.             Printer.Print Tab(TabNow); ColText;
  194.             TabPos = TabPos + ColWide + 2
  195.         End If
  196.         Next n
  197.         Printer.Print   'forces CR/LF at end of Row
  198.     End If
  199.  
  200.     'Body Info -----------------------------------------
  201.     TabPos = 2
  202.     MyTrueGrid.RowIndex = r
  203.     For c = 1 To MyTrueGrid.Columns
  204.         MyTrueGrid.ColumnIndex = c
  205.         If MyTrueGrid.ColumnVisible(c) = True Then
  206.         'Calculation for Tab() positions
  207.         ColWide = MyTrueGrid.ColumnWidth(c)
  208.         ColText = MyTrueGrid.text 'Table.ColumnText() = unformatted
  209.         ColStyle = MyTrueGrid.ColumnStyle(c)
  210.         Select Case ColStyle
  211.             Case 8192 'Left-align/Read only
  212.             TabNow = TabPos
  213.             Case 8193 'Centre/Read only
  214.             TabNow = (TabPos + ColWide \ 2) - (Len(ColText) \ 2)
  215.             Case 8194 'Right-align/Read only
  216.             TabNow = (TabPos + ColWide) - Len(ColText)
  217.         End Select
  218.         Printer.Print Tab(TabNow); ColText;
  219.         TabPos = TabPos + ColWide + 2
  220.         End If
  221.     Next
  222.     Printer.Print   'forces CR/LF at end of Row
  223.  
  224.     'Footer Info ---------------------------------------
  225.     If LineCount = 42 Then
  226.         Printer.Print   'Blank line
  227.         TabPos = (Printer.ScaleWidth \ 2) - (Len(PageFoot) \ 2)
  228.         Printer.Print Tab(TabPos); PageFoot; Printer.Page
  229.         Printer.NewPage : LineCount = 0
  230.         DoEvents    'allow Windows access at end of every page
  231.     End If
  232.     Next
  233.  
  234.     'Reset display and position to 1st row / 1st column
  235.     MyTrueGrid.TopRow = 1: MyTrueGrid.RowIndex = 1
  236.     MyTrueGrid.LeftColumn = 1: MyTrueGrid.ColumnIndex = 1
  237.     DoEvents
  238.  
  239.     'print page footer on last/short page ------------------
  240.     If Not LineCount = 42 Then
  241.     Do Until LineCount = 42
  242.         Printer.Print   'Blank line
  243.         LineCount = LineCount + 1
  244.     Loop
  245.     Printer.Print   'Blank line
  246.     TabPos = (Printer.ScaleWidth \ 2) - (Len(PageFoot) \ 2)
  247.     Printer.Print Tab(TabPos); PageFoot; Printer.Page
  248.     LineCount = 0
  249.     End If
  250. '   NewPage / Endoc ensures no blank page before ending print
  251.     Printer.NewPage : Printer.EndDoc
  252.     Screen.MousePointer = 0     'Return cursor to default
  253.  
  254. End Sub
  255.  
  256.